home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
pwxms.zip
/
XMS.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-01-04
|
11KB
|
357 lines
{
Oil Management Services Limited
Turbo Pascal Standard Library
XMS.PAS - eXtended Memory Support
Part Number : 20-0013
Version : 1.00
Date : 24th July 1989
}
UNIT XMS ;
{
Export Declarations & Definitions Section
}
INTERFACE
{
The purpose of this Unit is to implement an interface between a Turbo
Pascal program and an XMS driver. It implements those functions defined
in the Extended Memory Specification (XMS) Version 2.00 for MS-DOS.
XMS allows DOS programs to utilise additional memory found in Intel's
80286 and 80386 based machines in a consistent, machine independent
manner. With some restrictions, XMS adds almost 64K to the 640K which
DOS programs can access directly. Depending on avaliable hardware, XMS
may provide even more memory to DOS programs. XMS also provides DOS
programs with a standard method of storing data in extended memory.
}
{
Constants for XMSStatus Return Values
}
CONST
XMSStatus_OperationSuccessful = $00 ;
XMSStatus_FunctionNotImplemented = $80 ;
XMSStatus_VDISKDetected = $81 ;
XMSStatus_A20Error = $82 ;
XMSStatus_GeneralDriverError = $8e ;
XMSStatus_UnRecoverableDriverError = $8f ;
XMSStatus_HMADoesNotExist = $90 ;
XMSStatus_HMAInUse = $91 ;
XMSStatus_LessThanHMAMIN = $92 ;
XMSStatus_HMANotAllocated = $93 ;
XMSStatus_A20StillEnabled = $94 ;
XMSStatus_AllEMAllocated = $a0 ;
XMSStatus_AllEMHandlesInUse = $a1 ;
XMSStatus_HandleInvalid = $a2 ;
XMSStatus_SourceHandleInvalid = $a3 ;
XMSStatus_SourceOffsetInvalid = $a4 ;
XMSStatus_DestHandleInvalid = $a5 ;
XMSStatus_DestOffsetInvalid = $a6 ;
XMSStatus_LengthInvalid = $a7 ;
XMSStatus_MoveInvalidOverlap = $a8 ;
XMSStatus_ParityError = $a9 ;
XMSStatus_BlockNotLocked = $aa ;
XMSStatus_BlockLocked = $ab ;
XMSStatus_BlockLockCountOverflow = $ac ;
XMSStatus_LockFails = $ad ;
XMSStatus_SmallerUMBAvailiable = $b0 ;
XMSStatus_NoUMBsAvaliable = $b1 ;
XMSStatus_UMBSegmentNumberInvalid = $b2 ;
VAR
XMSStatus : BYTE ;
{
XMS Driver Information Constants
}
CONST
XMSInstalled : BOOLEAN = FALSE ;
XMSVersionNumber : EXTENDED = 0.0 ;
XMSDriverInternalRevisionNumber : EXTENDED = 0.0 ;
XMSHMAExists : BOOLEAN = FALSE ;
{
HMA Management Routines
}
PROCEDURE XMSRequestHMA ;
PROCEDURE XMSReleaseHMA ;
{
A20 Management Routines
}
PROCEDURE XMSGlobalEnableA20 ;
PROCEDURE XMSGlobalDisableA20 ;
PROCEDURE XMSLocalEnableA20 ;
PROCEDURE XMSLocalDisableA20 ;
FUNCTION XMSQueryA20:BOOLEAN ;
{
Extended Memory Management Routines
}
FUNCTION XMSLargestFreeEMB:WORD ;
FUNCTION XMSTotalFreeEM:WORD ;
FUNCTION XMSAllocEMB(Amount:WORD):WORD ;
PROCEDURE XMSFreeEMB(Handle:WORD) ;
PROCEDURE XMSMoveMemtoEMB(Handle1:WORD;Ptr1:POINTER;Length:LONGINT) ;
PROCEDURE __XMSMoveMemtoEMB(Handle1:WORD;Ptr1:POINTER;Offset2:LONGINT;Length:LONGINT) ;
PROCEDURE XMSMoveMemtoMem(Ptr1,Ptr2:POINTER;Length:LONGINT) ;
PROCEDURE XMSMoveEMBtoMem(Handle1:WORD;Ptr1:POINTER;Length:LONGINT) ;
PROCEDURE __XMSMoveEMBtoMem(Handle1:WORD;Offset1:LONGINT;Ptr2:POINTER;Length:LONGINT) ;
PROCEDURE XMSMoveEMBtoEMB(Handle1,Handle2:WORD;Length:LONGINT) ;
FUNCTION XMSLockEMB(Handle:WORD):POINTER ;
PROCEDURE XMSUnLockEMB(Handle:WORD) ;
FUNCTION XMSGetEMBLockCount(Handle:WORD):BYTE ;
FUNCTION XMSGetFreeEMBHandles(Handle:WORD):BYTE ;
FUNCTION XMSGetEMBLength(Handle:WORD):WORD ;
PROCEDURE XMSReAllocEMB(Handle,NewSize:WORD) ;
{
Upper Memory Management Routines
}
FUNCTION XMSRequestUMB(VAR Amount:WORD):WORD ; { *** DO NOT USE YET --> BUGGY *** }
PROCEDURE XMSReleaseUMB(SegmentNumber:WORD) ;
{
Miscellaneous
}
FUNCTION HexStr(dd:BYTE):STRING ;
{
Implementation Section
}
VAR
{
*** DO NOT MODIFY THIS IT REALLY SHOULD NOT BE EXPORTED ***
}
XMSControl : POINTER ;
IMPLEMENTATION
{$f-}
FUNCTION _XMSInstalled:BYTE ; EXTERNAL ;
FUNCTION _XMSVersionNumber:WORD ; EXTERNAL ;
FUNCTION _XMSDriverInternalRevisionNumber:WORD ; EXTERNAL ;
FUNCTION _XMSHMAExists:BYTE ; EXTERNAL ;
PROCEDURE XMSRequestHMA ; EXTERNAL ;
PROCEDURE XMSReleaseHMA ; EXTERNAL ;
PROCEDURE XMSGlobalEnableA20 ; EXTERNAL ;
PROCEDURE XMSGlobalDisableA20 ; EXTERNAL ;
PROCEDURE XMSLocalEnableA20 ; EXTERNAL ;
PROCEDURE XMSLocalDisableA20 ; EXTERNAL ;
FUNCTION _XMSQueryA20:WORD ; EXTERNAL ;
FUNCTION XMSLargestFreeEMB:WORD ; EXTERNAL ;
FUNCTION XMSTotalFreeEM:WORD ; EXTERNAL ;
FUNCTION XMSAllocEMB(Amount:WORD):WORD ; EXTERNAL ;
PROCEDURE XMSFreeEMB(Handle:WORD) ; EXTERNAL ;
PROCEDURE _XMSMoveEMB(ExtMemMoveStructPtr:POINTER) ; EXTERNAL ;
FUNCTION XMSLockEMB(Handle:WORD):POINTER ; EXTERNAL ;
PROCEDURE XMSUnLockEMB(Handle:WORD) ; EXTERNAL ;
FUNCTION XMSGetEMBLockCount(Handle:WORD):BYTE ; EXTERNAL ;
FUNCTION XMSGetFreeEMBHandles(Handle:WORD):BYTE ; EXTERNAL ;
FUNCTION XMSGetEMBLength(Handle:WORD):WORD ; EXTERNAL ;
PROCEDURE XMSReAllocEMB(Handle,NewSize:WORD) ; EXTERNAL ;
FUNCTION XMSRequestUMB(VAR Amount:WORD):WORD ; EXTERNAL ;
PROCEDURE XMSReleaseUMB(SegmentNumber:WORD) ; EXTERNAL ;
{$f+}
PROCEDURE _XMSNotInitialised ; EXTERNAL ;
{$f-}
{$L XMS.OBJ}
{
This Function Converts BCD Numbers to Extended Type Reals
}
FUNCTION BCDtoExtended(BCD:WORD):EXTENDED ;
{
Declarations & Definitions
}
VAR
Digit : WORD ;
dd : EXTENDED ;
{
MAIN - Statement Part of BCDtoExtended
}
BEGIN
dd := 0.0 ;
Digit := (BCD AND $f000) SHR 12 ; dd := dd + Digit * 1.0e+1 ;
Digit := (BCD AND $0f00) SHR 08 ; dd := dd + Digit * 1.0e+0 ;
Digit := (BCD AND $00f0) SHR 04 ; dd := dd + Digit * 1.0e-1 ;
Digit := (BCD AND $000f) SHR 00 ; dd := dd + Digit * 1.0e-2 ;
BCDtoExtended := dd ;
END ;
{
This Function checks to see if the A20 line is physically enabled.
It does this in a hardware independent manner by seeing if
"memory wrap" occurs
}
FUNCTION XMSQueryA20:BOOLEAN ;
BEGIN
XMSQueryA20 := _XMSQueryA20 = $0001 ;
END ;
{
Extended Memory Move Structure Definition
}
VAR
ExtMemMoveStruct : RECORD
Length : LONGINT ;
SourceHandle : WORD ;
SourceOffset : POINTER ;
DestHandle : WORD ;
DestOffset : POINTER ;
END ;
{
These procedures attempt to transfer a block of data from one
location to another. They are primarily intended for moving blocks
of data between conventional memory and extended memory, however
they can be used for moving blocks within conventional memory and
within extended memory.
}
PROCEDURE XMSMoveMemToMem ;
BEGIN
ExtMemMoveStruct.Length := Length ;
ExtMemMoveStruct.SourceHandle := $0000 ;
ExtMemMoveStruct.SourceOffset := Ptr1 ;
ExtMemMoveStruct.DestHandle := $0000 ;
ExtMemMoveStruct.DestOffset := Ptr2 ;
_XMSMoveEMB(@ExtMemMoveStruct) ;
END ;
PROCEDURE XMSMoveMemToEMB ;
BEGIN
ExtMemMoveStruct.Length := Length ;
ExtMemMoveStruct.SourceHandle := $0000 ;
ExtMemMoveStruct.SourceOffset := Ptr1 ;
ExtMemMoveStruct.DestHandle := Handle1 ;
ExtMemMoveStruct.DestOffset := NIL ;
_XMSMoveEMB(@ExtMemMoveStruct) ;
END ;
PROCEDURE __XMSMoveMemToEMB ;
BEGIN
ExtMemMoveStruct.Length := Length ;
ExtMemMoveStruct.SourceHandle := $0000 ;
ExtMemMoveStruct.SourceOffset := Ptr1 ;
ExtMemMoveStruct.DestHandle := Handle1 ;
ExtMemMoveStruct.DestOffset := POINTER(Offset2) ;
_XMSMoveEMB(@ExtMemMoveStruct) ;
END ;
PROCEDURE XMSMoveEMBToMem ;
BEGIN
ExtMemMoveStruct.Length := Length ;
ExtMemMoveStruct.SourceHandle := Handle1 ;
ExtMemMoveStruct.SourceOffset := NIL ;
ExtMemMoveStruct.DestHandle := $0000 ;
ExtMemMoveStruct.DestOffset := Ptr1 ;
_XMSMoveEMB(@ExtMemMoveStruct) ;
END ;
PROCEDURE __XMSMoveEMBToMem ;
BEGIN
ExtMemMoveStruct.Length := Length ;
ExtMemMoveStruct.SourceHandle := Handle1 ;
ExtMemMoveStruct.SourceOffset := POINTER(Offset1) ;
ExtMemMoveStruct.DestHandle := $0000 ;
ExtMemMoveStruct.DestOffset := Ptr2 ;
_XMSMoveEMB(@ExtMemMoveStruct) ;
END ;
PROCEDURE XMSMoveEMBToEMB ;
BEGIN
ExtMemMoveStruct.Length := Length ;
ExtMemMoveStruct.SourceHandle := Handle1 ;
ExtMemMoveStruct.SourceOffset := NIL ;
ExtMemMoveStruct.DestHandle := Handle2 ;
ExtMemMoveStruct.DestOffset := NIL ;
_XMSMoveEMB(@ExtMemMoveStruct) ;
END ;
{
This Function Converts a Byte to a Hex String
}
FUNCTION HexStr ;
{
Declarations & Definitions
}
CONST
HexDigits : ARRAY[$0..$f] OF CHAR = ('0','1','2','3','4','5','6','7','8','9','a','b','c','d','e','f') ;
{
MAIN - Statement Part of HexStr
}
BEGIN
HexStr := HexDigits[dd AND $f0 shr 4] + HexDigits[dd AND $0f] ;
END ;
{
MAIN - Start Up Code for XMS.PAS
}
BEGIN
{
Install Default XMS Control Function
}
XMSControl := @_XMSNotInitialised ;
{
Check XMS Driver is Installed & Try to Install XMS Control Function
}
XMSInstalled := _XMSInstalled = $80 ;
{
Set-Up Exported Variables
}
IF (XMSInstalled) THEN BEGIN
XMSVersionNumber := BCDtoExtended(_XMSVersionNumber) ;
XMSDriverInternalRevisionNumber := BCDtoExtended(_XMSDriverInternalRevisionNumber) ;
XMSHMAExists := _XMSHMAExists = $0001 ;
END ;
END.